library("FactoMineR")
library("factoextra")# Valores de los gráficos por defecto
mi.tema <- theme_grey() + theme(panel.border = element_rect(fill = NA,color = "white"), plot.title = element_text(hjust = 0.5))setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method = "complete")plot(modelo)plot(modelo,hang = -1)
# la siguiente instrucción separa los clústeres usando 3
rect.hclust(modelo, k=3, border="red")fviz_dend(modelo, cex = 1.3,ggtheme = mi.tema)# la siguiente instrucción separa los clústeres usando 3
fviz_dend(modelo, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#1B9E77", "#D95F02", "#7570B3"), ggtheme = mi.tema)setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method = "single")plot(modelo,hang=-1)
rect.hclust(modelo, k=3, border="blue")fviz_dend(modelo, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#1B9E77", "#D95F02", "#7570B3"), ggtheme = mi.tema)setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method = "average")plot(modelo)
rect.hclust(modelo, k=3, border="green")fviz_dend(modelo, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#1B9E77", "#D95F02", "#7570B3"), ggtheme = mi.tema)setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method= "ward.D")plot(modelo,hang=-1)
rect.hclust(modelo, k=3, border="magenta")fviz_dend(modelo, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#1B9E77", "#D95F02", "#7570B3"), ggtheme = mi.tema)# cutree corta el el árbol con k clústeres
Grupo<-cutree(modelo,k=3)
NDatos<-cbind(Datos,Grupo)
NDatos## Matematicas Ciencias Espanol Historia EdFisica Grupo
## Lucia 7.0 6.5 9.2 8.6 8.0 1
## Pedro 7.5 9.4 7.3 7.0 7.0 2
## Ines 7.6 9.2 8.0 8.0 7.5 2
## Luis 5.0 6.5 6.5 7.0 9.0 3
## Andres 6.0 6.0 7.8 8.9 7.3 1
## Ana 7.8 9.6 7.7 8.0 6.5 2
## Carlos 6.3 6.4 8.2 9.0 7.2 1
## Jose 7.9 9.7 7.5 8.0 6.0 2
## Sonia 6.0 6.0 6.5 5.5 8.7 3
## Maria 6.8 7.2 8.7 9.0 7.0 1
# Establezco el directorio en donde se quiere grabar el archivo
setwd("~/Google Drive/MDCurso/Datos")
# Se graba el archivo en como un CSV
write.csv(NDatos,"NDatos.csv")# Ejemplo de las importaciones de México
setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('ImportacionesMexico.csv', header=TRUE, sep=';',dec=',',row.names=1)
res <- PCA(Datos , scale.unit=TRUE, ncp=5, graph = FALSE)
res.hcpc <- HCPC(res, nb.clust = -1, consol = TRUE, min = 3, max = 3, graph = FALSE)plot.HCPC(res.hcpc, choice="bar")plot.HCPC(res.hcpc, choice="map",select="cos2 0.1")fviz_cluster(res.hcpc,repel = TRUE,show.clust.cent = TRUE,palette = "jco",main = "Factor map",geom = "text", select.ind = list(cos2 = 0.1))plot.HCPC(res.hcpc, choice="3D.map", angle=60)library(cluster) # Para menejo de clusteres# Función para encontrar el centroide de cada cluster
centroide <- function(num.cluster, datos, clusters) {
ind <- (clusters == num.cluster)
return(colMeans(datos[ind,]))
}
setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploEstudiantes.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method= "ward.D")
grupos <- cutree(modelo, k=3)
grupos## Lucia Pedro Ines Luis Andres Ana Carlos Jose Sonia Maria
## 1 2 2 3 1 2 1 2 3 1
centro.cluster1<-centroide(1,Datos,grupos)
centro.cluster1## Matematicas Ciencias Espanol Historia EdFisica
## 6.525 6.525 8.475 8.875 7.375
centro.cluster2<-centroide(2,Datos,grupos)
centro.cluster2## Matematicas Ciencias Espanol Historia EdFisica
## 7.700 9.475 7.625 7.750 6.750
centro.cluster3<-centroide(3,Datos,grupos)
centro.cluster3## Matematicas Ciencias Espanol Historia EdFisica
## 5.50 6.25 6.50 6.25 8.85
centros<-rbind(centro.cluster1,centro.cluster2,centro.cluster3)
centros## Matematicas Ciencias Espanol Historia EdFisica
## centro.cluster1 6.525 6.525 8.475 8.875 7.375
## centro.cluster2 7.700 9.475 7.625 7.750 6.750
## centro.cluster3 5.500 6.250 6.500 6.250 8.850
color <- c("#ECD078","#D95B43","#C02942","#542437","#53777A")
barplot(centros[1,],col=color,las=2, cex.names = 0.8, ylim = c(0,10))barplot(centros[2,],col=color,las=2, cex.names = 0.8, ylim = c(0,10))barplot(centros[3,],beside=TRUE,col=color,las=2, cex.names = 0.8, ylim = c(0,10))barplot(t(centros),beside=TRUE,col=color, cex.names = 0.8, ylim = c(0,10))centros<-as.data.frame(centros)
maximos<-apply(centros,2,max)
minimos<-apply(centros,2,min)
centros<-rbind(minimos,centros)
centros<-rbind(maximos,centros)
centros## Matematicas Ciencias Espanol Historia EdFisica
## 1 7.700 9.475 8.475 8.875 8.850
## 11 5.500 6.250 6.500 6.250 6.750
## centro.cluster1 6.525 6.525 8.475 8.875 7.375
## centro.cluster2 7.700 9.475 7.625 7.750 6.750
## centro.cluster3 5.500 6.250 6.500 6.250 8.850
library(fmsb) # Paquete para usar radarchartcolor <- c("#CC333F","#EB6841","#EDC951")
radarchart(as.data.frame(centros),maxmin=TRUE,axistype=4,axislabcol="slategray4",
centerzero=FALSE,seg=8, cglcol="gray67",
pcol=color,plty=1,plwd=5,title="Comparación de clústeres")
legenda <-legend(1.5,1, legend=c("Cluster 1","Cluster 2","Cluster 3"),
seg.len=-1.4,title="Clústeres",pch=21,bty="n" ,lwd=3, y.intersp=1,
horiz=FALSE,col=color)setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.table('EjemploClientesCorregidaEdad.csv', header=TRUE, sep=';',dec=',',row.names=1)
modelo <- hclust(dist(Datos),method= "ward.D")plot(modelo,las=1,hang=-1)fviz_dend(modelo, cex = 1,ggtheme = mi.tema)# Para encontrar el centroide de cada cluster
grupos <- cutree(modelo, k=3)
centro.cluster1<-centroide(1,Datos,grupos)
centro.cluster2<-centroide(2,Datos,grupos)
centro.cluster3<-centroide(3,Datos,grupos)
centros<-rbind(centro.cluster1,centro.cluster2,centro.cluster3)
color <- c("#FF6449", "#FEB035", "#FCE020", "#F7EC69", "#F1F8BE","#D5B9F6",
"#A2E3CD","#EDF380", "#D8FD9C", "#AEEC64", "#F598F8", "#9EFF37")
barplot(centros[1,],col=color,las=2,cex.names = 0.65, ylim = c(0,12))barplot(centros[2,],col=color,las=2, cex.names = 0.65, ylim = c(0,12))barplot(centros[3,],beside=TRUE,col=color,las=2, cex.names = 0.65, ylim = c(0,12))barplot(t(centros),beside=TRUE,legend=colnames(Datos),main = "Gráfico de Interpretación de Clases",col=color, cex.names = 0.65, ylim = c(0,25))centros<-as.data.frame(centros)
maximos<-apply(centros,2,max)
minimos<-apply(centros,2,min)
centros<-rbind(minimos,centros)
centros<-rbind(maximos,centros)
centros## Edad.10 Antiguedad Espacios.Parqueo Velocidad.Cajas
## 1 3.080000 5.833333 6.850000 8.34
## 11 2.360000 0.600000 5.466667 7.44
## centro.cluster1 2.360000 0.600000 6.220000 8.34
## centro.cluster2 3.066667 5.833333 6.850000 8.10
## centro.cluster3 3.080000 3.000000 5.466667 7.44
## Distribucion.Productos Atencion.Empleados
## 1 8.120000 9.713333
## 11 4.626667 9.508333
## centro.cluster1 8.120000 9.700000
## centro.cluster2 7.600000 9.508333
## centro.cluster3 4.626667 9.713333
## Calidad.Instalaciones Ubicacion Limpieza
## 1 4.700000 9.160000 7.450000
## 11 2.406667 8.833333 5.626667
## centro.cluster1 4.700000 9.160000 7.360000
## centro.cluster2 3.500000 8.833333 7.450000
## centro.cluster3 2.406667 9.026667 5.626667
## Variedad.Productos Prestigio.Empresa Calidad.Servicio
## 1 7.466667 8.520000 5.325
## 11 5.960000 5.426667 4.960
## centro.cluster1 7.440000 8.520000 5.070
## centro.cluster2 7.466667 7.933333 5.325
## centro.cluster3 5.960000 5.426667 4.960
color <- c("#61492D","#939C53","#F3D079")
radarchart(as.data.frame(centros),maxmin=TRUE,axistype=4,axislabcol="slategray4",
centerzero=FALSE,seg=8, cglcol="gray67",
pcol=color,plty=1,plwd=5,title="Comparación de clústeres")
legenda <-legend(1.5,1, legend=c("Cluster 1","Cluster 2","Cluster 3"),
seg.len=-1.4,title="Clústeres",pch=21,bty="n" ,lwd=3, y.intersp=1,
horiz=FALSE,col=color)La función “daisy” de la biblioteca “cluster” permite calcular la matriz de distancias en tablas de datos cuyas variables están mezcladas entre variables cualtitativas y cuantitativas.
library(cluster)
setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.csv("SAheart.csv",header=TRUE, sep=";", dec=".")
str(Datos)## 'data.frame': 462 obs. of 10 variables:
## $ sbp : int 160 144 118 170 134 132 142 114 114 132 ...
## $ tobacco : num 12 0.01 0.08 7.5 13.6 6.2 4.05 4.08 0 0 ...
## $ ldl : num 5.73 4.41 3.48 6.41 3.5 6.47 3.38 4.59 3.83 5.8 ...
## $ adiposity: num 23.1 28.6 32.3 38 27.8 ...
## $ famhist : Factor w/ 2 levels "Absent","Present": 2 1 2 2 2 2 1 2 2 2 ...
## $ typea : int 49 55 52 51 60 62 59 62 49 69 ...
## $ obesity : num 25.3 28.9 29.1 32 26 ...
## $ alcohol : num 97.2 2.06 3.81 24.26 57.34 ...
## $ age : int 52 63 46 58 49 45 38 58 29 53 ...
## $ chd : Factor w/ 2 levels "No","Si": 2 2 1 2 2 1 1 2 1 2 ...
dim(Datos)## [1] 462 10
head(Datos)## sbp tobacco ldl adiposity famhist typea obesity alcohol age chd
## 1 160 12.00 5.73 23.11 Present 49 25.30 97.20 52 Si
## 2 144 0.01 4.41 28.61 Absent 55 28.87 2.06 63 Si
## 3 118 0.08 3.48 32.28 Present 52 29.14 3.81 46 No
## 4 170 7.50 6.41 38.03 Present 51 31.99 24.26 58 Si
## 5 134 13.60 3.50 27.78 Present 60 25.99 57.34 49 Si
## 6 132 6.20 6.47 36.21 Present 62 30.77 14.14 45 No
D<-daisy(Datos, metric = "euclidean")## Warning in daisy(Datos, metric = "euclidean"): with mixed variables, metric
## "gower" is used automatically
jer<-hclust(D, method = "complete")plot(jer)
rect.hclust(jer, k = 3, border = "red")fviz_dend(jer, k = 3, cex = 1.3, color_labels_by_k = FALSE, rect = TRUE,k_colors = c("#515151", "#F38630", "#00B4FF", "#ECD078"), ggtheme = mi.tema, show_labels = F)Warning in get_col(col, k): Length of color vector was longer than the
number of clusters - first k elements are used
grupo<-cutree(jer, k = 3)
NDatos<-cbind(Datos,grupo)
head(NDatos)## sbp tobacco ldl adiposity famhist typea obesity alcohol age chd grupo
## 1 160 12.00 5.73 23.11 Present 49 25.30 97.20 52 Si 1
## 2 144 0.01 4.41 28.61 Absent 55 28.87 2.06 63 Si 2
## 3 118 0.08 3.48 32.28 Present 52 29.14 3.81 46 No 3
## 4 170 7.50 6.41 38.03 Present 51 31.99 24.26 58 Si 1
## 5 134 13.60 3.50 27.78 Present 60 25.99 57.34 49 Si 1
## 6 132 6.20 6.47 36.21 Present 62 30.77 14.14 45 No 3
# Se deben quitar las variables cualitativas para hacer un gráfico tipo araña
setwd("~/Google Drive/MDCurso/Datos")
Datos <- read.csv("SAheart.csv",header=TRUE, sep=";", dec=".")
str(Datos)## 'data.frame': 462 obs. of 10 variables:
## $ sbp : int 160 144 118 170 134 132 142 114 114 132 ...
## $ tobacco : num 12 0.01 0.08 7.5 13.6 6.2 4.05 4.08 0 0 ...
## $ ldl : num 5.73 4.41 3.48 6.41 3.5 6.47 3.38 4.59 3.83 5.8 ...
## $ adiposity: num 23.1 28.6 32.3 38 27.8 ...
## $ famhist : Factor w/ 2 levels "Absent","Present": 2 1 2 2 2 2 1 2 2 2 ...
## $ typea : int 49 55 52 51 60 62 59 62 49 69 ...
## $ obesity : num 25.3 28.9 29.1 32 26 ...
## $ alcohol : num 97.2 2.06 3.81 24.26 57.34 ...
## $ age : int 52 63 46 58 49 45 38 58 29 53 ...
## $ chd : Factor w/ 2 levels "No","Si": 2 2 1 2 2 1 1 2 1 2 ...
D<-daisy(Datos, metric = "euclidean")## Warning in daisy(Datos, metric = "euclidean"): with mixed variables, metric
## "gower" is used automatically
jer<-hclust(D, method = "complete")
grupos <- cutree(jer, k=3)
centro.cluster1<-centroide(1,Datos[,-c(5,10)],grupos)
centro.cluster2<-centroide(2,Datos[,-c(5,10)],grupos)
centro.cluster3<-centroide(3,Datos[,-c(5,10)],grupos)
centros<-rbind(centro.cluster1,centro.cluster2,centro.cluster3)
centros<-as.data.frame(centros)
maximos<-apply(centros,2,max)
minimos<-apply(centros,2,min)
centros<-rbind(minimos,centros)
centros<-rbind(maximos,centros)
centros## sbp tobacco ldl adiposity typea obesity
## 1 144.3229 5.913281 5.866771 28.69698 54.56250 26.83281
## 11 135.4603 2.634735 4.344238 23.96911 52.36755 25.73745
## centro.cluster1 144.3229 5.265937 5.866771 28.69698 54.44792 26.83281
## centro.cluster2 142.8594 5.913281 4.919688 27.25516 54.56250 26.30813
## centro.cluster3 135.4603 2.634735 4.344238 23.96911 52.36755 25.73745
## alcohol age
## 1 21.06146 51.55208
## 11 15.93136 38.85430
## centro.cluster1 21.06146 51.55208
## centro.cluster2 16.27094 48.40625
## centro.cluster3 15.93136 38.85430
color <- c("#FCEBB6","#78C0A8","#5E412F")
radarchart(as.data.frame(centros),maxmin=TRUE,axistype=4,axislabcol="slategray4",
centerzero=FALSE,seg=8, cglcol="gray67",
pcol=color,plty=1,plwd=5,title="Comparación de clústeres")
legenda <-legend(1.5,1, legend=c("Cluster 1","Cluster 2","Cluster 3"),
seg.len=-1.4,title="Clústeres",pch=21,bty="n" ,lwd=3, y.intersp=1,
horiz=FALSE,col=color)grupo <- cutree(jer, k = 3)
NDatos <- cbind(Datos, grupo)
cluster <- NDatos$grupo
sel.cluster1 <- match(cluster, 1, 0)
sel.cluster1[1:10]## [1] 1 0 0 1 1 0 0 1 0 1
Datos.Cluster1 <- NDatos[sel.cluster1 > 0,]
dim(Datos.Cluster1)## [1] 96 11
sel.cluster2 <- match(cluster, 2, 0)
Datos.Cluster2 <- NDatos[sel.cluster2 > 0,]
dim(Datos.Cluster2)## [1] 64 11
sel.cluster3 <- match(cluster, 3, 0)
Datos.Cluster3 <- NDatos[sel.cluster3 > 0,]
dim(Datos.Cluster3)## [1] 302 11
color1 <- c("#ECD078","#D95B43")
plot(Datos$famhist, col = color1, las = 2, main = "Variable famhist", xlab = "Todos los Datos")plot(Datos.Cluster1$famhist, col = color1, las = 2, main = "Variable famhist", xlab = "Cluster 1")plot(Datos.Cluster2$famhist, col = color1, las = 2, main = "Variable famhist", xlab = "Cluster 2")plot(Datos.Cluster3$famhist, col = color1, las = 2, main = "Variable famhist", xlab = "Cluster 3")color2 <- c("#45ADA8","#9DE0AD")
plot(Datos$chd, col = color2, las = 2, main = "Variable chd", xlab = "Todos los Datos")plot(Datos.Cluster1$chd, col = color2, las = 2, main = "Variable chd", xlab = "Cluster 1")plot(Datos.Cluster2$chd, col = color2, las = 2, main = "Variable chd", xlab = "Cluster 2")plot(Datos.Cluster3$chd, col = color2, las = 2, main = "Variable chd", xlab = "Cluster 3")